RLadies y Data Scientists en Kernel Analytics
Código y datos en https://github.com/intiveda/rladies_textmining
Gran parte de los datos se encuentran no estructurados, es importante conocer técnicas que nos permitan obtener conclusiones a partir de los mensajes que generan nuestras organizaciones, clientes o usuarios.
Hoy aprenderemos algunas técnicas básicas para manipular cadenas de texto y aplicaremos técnicas de NLP a subtítulos para obtener algunas conclusiones.
stringrsubtoolstmtidytexttidyversedplyrdatatableggplot2plotly(opcional)igraphggraphworldcloudknitrwordcloudPuedes seguir este tutorial de dos formas:
.Rmd en R Studio (para poder ejecutar notebooks necesitarás algunas dependencias)rladies_textmining: setwd("eldirectoriodondehasdescargadoelrepo/rladies_textmining/")c(
"stringr",
"subtools",
"tm",
"tidytext",
"tidyverse",
"dplyr",
"data.table",
"ggplot2",
"plotly",
"igraph",
"ggraph",
"wordcloud",
"knitr"
) %in% rownames(installed.packages())
[1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
Las cadenas o strings cumplen un papel importante en las tareas de ETL o preparación de los datos. Una de las librerías esenciales en la materia es stringr
Stringr es uno de los paquetes diseñados por Hadley Wickham para asistir en las tareas de manipulación de strings:
"" (*usar la comilla simple ' para escapar la doble comilla)"a", números "1", símbolos "&" o todo lo anterior "1a&"NAas.integer(c("a", "&", "123"))
[1] NA NA 123
c(factor("a"), "b", "&",1)
[1] "1" "b" "&" "1"
Concatenar integers y characters, convierte automáticamente los integers en characters.
c(as.character(factor("a")), "b", "&",1)
[1] "a" "b" "&" "1"
# install.packages("stringr")
library(stringr)
Muchas de estas funciones tiene su equivalente en R base, pueden ser más lentas/menos eficientes.
str_to_upper(string): convierte un string en mayúsculasstr_to_lower(string): convierte un string en minúsculasstr_to_title(string): capitaliza un stringtemas <- c("Código", "Mujeres", "tecnología", "Informática", "estadística", "Women", "Coders", "Aprendizaje", "automático", "Análisis", "datos", "Visualización", "R-Ladies", "Social", "Coding", "R", "Ciencia", "Programming")
str_to_upper(temas)
[1] "CÓDIGO" "MUJERES" "TECNOLOGÍA" "INFORMÁTICA" "ESTADÍSTICA" "WOMEN"
[7] "CODERS" "APRENDIZAJE" "AUTOMÁTICO" "ANÁLISIS" "DATOS" "VISUALIZACIÓN"
[13] "R-LADIES" "SOCIAL" "CODING" "R" "CIENCIA" "PROGRAMMING"
str_to_lower(temas)
[1] "código" "mujeres" "tecnología" "informática" "estadística" "women"
[7] "coders" "aprendizaje" "automático" "análisis" "datos" "visualización"
[13] "r-ladies" "social" "coding" "r" "ciencia" "programming"
str_to_title(temas)
[1] "Código" "Mujeres" "Tecnología" "Informática" "Estadística" "Women"
[7] "Coders" "Aprendizaje" "Automático" "Análisis" "Datos" "Visualización"
[13] "R-Ladies" "Social" "Coding" "R" "Ciencia" "Programming"
str_c(string, sep = ""): junta varios string en uno solo, es el equivalente a paste(sep = "") o paste0()str_length(string): devuelve la longitud del string, es similar a la función nchar(). Convierte los factores en strings y conserva los NA’sprint(str_length('R-Ladies'))
[1] 8
print(str_length(NA))
[1] NA
str_sub(string, start, end): subsetea un string o un vector de string especificando la posición inicial y la final, es el equivalente en R base a substr(). Por defecto finaliza en el último caracter.print(temas[1:4])
[1] "Código" "Mujeres" "tecnología" "Informática"
str_sub(string = temas[1:4], start=3)
[1] "digo" "jeres" "cnología" "formática"
str_dup(string, times): copia y pega un string un número determinado de vecesstr_dup(string = temas[1:4], times = 3)
[1] "CódigoCódigoCódigo" "MujeresMujeresMujeres"
[3] "tecnologíatecnologíatecnología" "InformáticaInformáticaInformática"
str_trim(string, side = c("both", "left", "rigth")): elimina los espacios vacíos, por defecto toma el valor both. Mejor evitar gsub(" ", "", string)str_pad(string, width, side = c("left", "both", "right"), pad = " ")): añade a strings espacios en blanco para igualarlos en longitud, especialmente útil para añadir 0 a números.Las expresiones regulares ( regular expressions, regex, pattern matching) son un lenguaje usado para parsear y manipular texto. Se usan comúnmente para hacer operaciones de búsqueda y reemplazo y para validar si un texto está bien formado.
Las expresiones regulares son un mundo en si mismo, aquí tienes una pequeña chuleta : https://www.rstudio.com/wp-content/uploads/2016/09/RegExCheatsheet.pdf
rcosas = c("baseR", "R-Ladies", "Rmeetup", "Rmarkdown", "stringR")
str_detect(rcosas, pattern = "^R")
[1] FALSE TRUE TRUE TRUE FALSE
rcosas[str_detect(rcosas, pattern = "^R")]
[1] "R-Ladies" "Rmeetup" "Rmarkdown"
rcosas[str_detect(rcosas, pattern = "R")]
[1] "baseR" "R-Ladies" "Rmeetup" "Rmarkdown" "stringR"
cleanR <- c("tidyverse", "tidyr","dplyr", "ggplot2", "tidytext", "purrr")
str_locate(cleanR, "tidy")
start end
[1,] 1 4
[2,] 1 4
[3,] NA NA
[4,] NA NA
[5,] 1 4
[6,] NA NA
str_extract(string, pattern) o str_extract_all(): busca la palabra exacta (normalmente se utiliza con expresiones regulares concatenadas)str_match(string, pattern) o str_match_all(): es una función equivalente pero devuelve una matrizstr_match(c("12345678", "12587465", "dni desconocido"), pattern = "[1-9]{8}")
[,1]
[1,] "12345678"
[2,] "12587465"
[3,] NA
str_match_all(c("12345678", "12587465", "dni desconocido"), pattern = "[1-9]{8}")
[[1]]
[,1]
[1,] "12345678"
[[2]]
[,1]
[1,] "12587465"
[[3]]
[,1]
str_replace(string, pattern, replacement): reemplaza la primera instancia, str_replace_all para reemplazarlas todasstr_replace(c("castanya", "otonyo", "veronyo", "anyo", "nyonyo"), pattern = "ny", replacement = "ñ")
[1] "castaña" "otoño" "veroño" "año" "ñonyo"
str_replace_all(c("castanya", "otonyo", "veronyo", "anyo", "nyonyo"), pattern = "ny", replacement = "ñ")
[1] "castaña" "otoño" "veroño" "año" "ñoño"
str_split(string, pattern): separa una cadena en un vector, str_split_fixed(string, pattern, n) lo hace en un número n determinado de elementosprint(str_split("Eres muy chu chu chuli",pattern = " "))
[[1]]
[1] "Eres" "muy" "chu" "chu" "chuli"
print(length(str_split("Eres muy chu chu chuli",pattern = " ")[[1]]))
[1] 5
La librería subtools permite leer archivos .str y .sub, así como organizar cada diálogo en un data frame.
Los archivos han de estar organizados en directorios por temporadas y cada uno ha de estar nombrado como S01xE01 para que se parsee correctamente el número de temporada y de episodio.
Nos centraremos en las 9 primeras temporadas de los Simpsons. Si descargamos la puntuación y representamos gráficamente el promedio del score por temporada, se observa un claro descenso a partir de la 10. Por otro lado son las temporadas que mejor conocemos gracias a sus numerosas repeticiones :)
knitr::include_graphics("./images/ratings.png",dpi = 100)
A continuación leemos los subtítulos ( en inglés ) de las 9 primeras temporadas de los Simpsons.
#devtools::install_github("fkeck/subtools")
library(subtools)
a <- read.subtitles.serie(dir = "./The Simpsons/")
Read: 9 seasons, 203 episodes
df <- subDataFrame(a)
df <- df[complete.cases(df), ]
str(df)
'data.frame': 57672 obs. of 8 variables:
$ ID : chr "<U+FEFF>1""| __truncated__ "2" "3" "4" ...
$ Timecode.in : chr "00:00:00.042" "00:00:08.759" "00:00:10.761" "00:00:15.557" ...
$ Timecode.out: chr "00:00:00.042" "00:00:10.677" "00:00:13.180" "00:00:17.851" ...
$ Text : chr "23.976" "Ooh! Careful, Homer!" "There's no time. We're late." "O little town of Bethlehem" ...
$ season : chr "season 1" "season 1" "season 1" "season 1" ...
$ season_num : num 1 1 1 1 1 1 1 1 1 1 ...
$ episode_num : num 1 1 1 1 1 1 1 1 1 1 ...
$ serie : chr "The Simpsons" "The Simpsons" "The Simpsons" "The Simpsons" ...
Una primera opción es emplear la librería tm para nuestro análisis. La función tm_map nos va a permitir preparar nuestor documento para el análisis:
library(tm)
Loading required package: NLP
c <- tmCorpus(a)
c <- tm_map(c, content_transformer(tolower))
c <- tm_map(c, removePunctuation)
c <- tm_map(c, removeNumbers)
c <- tm_map(c, removeWords, stopwords("english"))
c <- tm_map(c, stripWhitespace)
c
<<SimpleCorpus>>
Metadata: corpus specific: 1, document level (indexed): 4
Content: documents: 203
El segundo paso, una vez preparado nuestro corpus, será el de construir la matriz de términos documentos. Para simplificar el análisis cada temporada constituirá un documento. De esta forma obtenemos para cada término la frecuencia por temporada.
TDM <- TermDocumentMatrix(c)
TDM <- as.matrix(TDM)
vec.season <- c(rep(x = 1,13), rep(2, 22), rep(3,24), rep(4,22), rep(5,22), rep(6,25), rep(7,25),rep(8,25), rep(9,25)) #episodios por temp
TDM.season <- t(apply(TDM, 1, function(x) tapply(x, vec.season, sum)))
colnames(TDM.season) <- paste0("S_", unique(vec.season))
head(TDM.season)
Terms S_1 S_2 S_3 S_4 S_5 S_6 S_7 S_8 S_9
able 6 4 3 0 6 7 4 2 4
aboard 1 1 2 2 2 2 2 1 1
acts 1 1 1 0 0 1 0 0 1
adult 1 3 2 0 3 3 1 1 1
affecting 1 0 0 0 0 0 0 0 0
afford 5 8 5 1 2 4 8 6 1
A continuación representamos en una nube de términos dichas frecuencias: el tamaño indica el número de repeticiones y el color la temporada en la que más repeticiones presenta. La posición del término respecto de la etiqueta de temporada indica también la frecuencia por temporada.
library(wordcloud)
Loading required package: RColorBrewer
set.seed(100)
comparison.cloud(TDM.season, title.size = 1, max.words = 200, random.order = T)
La librería tidytext nos permite realizar operaciones como tf (frecuencia de términos) o tf_idf (frecuencia de término - frecuencia inversa de documento) con mayor agilidad.
De nuevo vamos a preparar el nuestros diálogos para el análisis eliminado las stopwords.
library(tidytext)
package <U+393C><U+3E31>tidytext<U+393C><U+3E32> was built under R version 3.3.3
library(tidyverse)
package <U+393C><U+3E31>tidyverse<U+393C><U+3E32> was built under R version 3.3.3package <U+393C><U+3E31>ggplot2<U+393C><U+3E32> was built under R version 3.3.3package <U+393C><U+3E31>tibble<U+393C><U+3E32> was built under R version 3.3.3package <U+393C><U+3E31>tidyr<U+393C><U+3E32> was built under R version 3.3.3package <U+393C><U+3E31>readr<U+393C><U+3E32> was built under R version 3.3.3package <U+393C><U+3E31>purrr<U+393C><U+3E32> was built under R version 3.3.3package <U+393C><U+3E31>dplyr<U+393C><U+3E32> was built under R version 3.3.3
data(stop_words)
tidy_df <- df %>%
unnest_tokens(word, Text) %>%
dplyr::anti_join(stop_words)
Eliminamos además aquellas “palabras” constituidas exclusivamente por números y la palabra simpson.
library(data.table)
data.table 1.10.4
The fastest way to learn (by data.table authors): https://www.datacamp.com/courses/data-analysis-the-data-table-way
Documentation: ?data.table, example(data.table) and browseVignettes("data.table")
Release notes, videos and slides: http://r-datatable.com
Attaching package: <U+393C><U+3E31>data.table<U+393C><U+3E32>
The following objects are masked from <U+393C><U+3E31>package:dplyr<U+393C><U+3E32>:
between, first, last
The following object is masked from <U+393C><U+3E31>package:purrr<U+393C><U+3E32>:
transpose
tidy_df <- as.data.table(tidy_df)
tidy_df <- tidy_df[is.na(as.numeric(word))]
tidy_df <- tidy_df[word != 'simpson']
Con nuestro data set limpio podemos representar en un gráfico de barras la frecuencia de términos. Lo que haremos será:
count)library(ggplot2)
tidy_df %>% group_by(season) %>%
count(word, sort = FALSE) %>%
top_n(15) %>%
ggplot(aes(reorder(word,n), n, fill = season)) +
geom_col() +
coord_flip() +
facet_wrap(~season, scales = "free_y") +
labs(x = NULL) +
guides(fill = FALSE) +
scale_fill_brewer(palette = "Set1")
Selecting by n
Ahora que disponemos de la frecuencia podemos analizar la evolución en sus apariciones / tramas de cada personaje: + calculamos la frecuencia para todos los términos, no solo el top 15 + creamos dos listas, la familia Simpson y otros personajes relevantes de la trama + representamos ambas series series temporales
#install.packages('plotly')
require(plotly)
tidy_tf <- tidy_df %>% group_by(season) %>%
count(word, sort = TRUE)
tidy_tf <- as.data.table(tidy_tf)
simpson_family <- c('homer', 'bart', 'lisa', 'maggie', 'marge', 'patty','selma')
other_characters <- c('moe', 'ned', 'barney', 'modd', 'itchy', 'scratchy', 'krusty', 'burns', 'lenny', 'carl', 'edna', 'nelson', 'apu', 'milhouse', 'ralph', 'skinner', 'bob')
myplot <- ggplot(tidy_tf[tidy_tf$word %in% simpson_family], aes(x=season, y=n, group=word)) +
geom_line(aes(color=word), size=1.25)+
geom_point(aes(color=word))
ggplotly(myplot)
myplot <- ggplot(tidy_tf[tidy_tf$word %in% other_characters], aes(x=season, y=n, group=word)) +
geom_line(aes(color=word), size=0.75)+
geom_point(aes(color=word))
ggplotly(myplot)
También podemos obtener y representar los bigramas (conjunto de 2 términos) y sus frecuencias. Se representan en forma de grafo los más comunes (aquellos que aparecen al menos 7 veces en una misma temporada)
library(tidyr)
library(igraph)
library(tidytext)
bigram_graph <- df %>%
unnest_tokens(bigram, Text, token = "ngrams", n = 2) %>%
separate(bigram, c("word1", "word2"), sep = " ") %>%
filter(!word1 %in% stop_words$word) %>%
filter(!word2 %in% stop_words$word) %>%
group_by(season) %>%
count(word1, word2, sort = TRUE) %>%
select(word1, word2, season, n) %>%
filter(n > 7) %>%
graph_from_data_frame()
# str(bigram_graph)
library(ggraph)
set.seed(2017)
ggraph(bigram_graph, layout = "fr") +
geom_edge_link() +
geom_node_point() +
geom_node_text(aes(label = name), vjust = 1, hjust = 1)
a <- grid::arrow(type = "closed", length = unit(.15, "inches"))
ggraph(bigram_graph, layout = "fr") +
geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
arrow = a, end_cap = circle(.07, 'inches')) +
geom_node_point(color = "lightblue", size = 5) +
geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
theme_void()
También podemos realizar tf_idf sobre nuestro corpus para localizar las palabras más relevantes, en general y por temporada
library(dplyr)
tf_idf_df <- tidy_df %>%
count(season, word, sort = TRUE) %>%
bind_tf_idf(word, season, n)
tf_idf_df <- tf_idf_df[order(-tf_idf_df$tf_idf),]
tf_idf_df %>%
top_n(20) %>%
ggplot(aes(word, tf_idf, fill = season)) +
geom_col() +
labs(x = NULL, y = "tf-idf") +
coord_flip()
Selecting by tf_idf
tf_idf_df %>%
group_by(season) %>%
top_n(8) %>%
ungroup %>%
ggplot(aes(reorder(word, tf_idf), tf_idf, fill = season)) +
geom_col(show.legend = FALSE) +
labs(x = NULL, y = "tf-idf") +
facet_wrap(~season, ncol = 2, scales = "free") +
coord_flip()
Selecting by tf_idf
Valorar como positivo o negativo un mensaje es una tarea compleja, que requiere no sólo conocer el significado de las palabras sino también contextualizarlas, conocer la entonación en que se produce el mensaje, etc.
En este caso vamos a realizar una aproximación mucho más simple, que es la de considerar el texto como la combinación de palabras individuales y el sentimiento como la suma del sentimiento asociado a cada una de las palabras. Para ello tidytextnos ofrece tres posibles datasets (lexicon) de sentimientos: + AFINN from Finn Årup Nielsen (-5, 5), + bing from Bing Liu and collaborators(“positive” / “negative”) + nrc from Saif Mohammad and Peter Turney (“yes” / “no”).
Todos ellos basados en unigramas.
head(get_sentiments("afinn"), 3)
head(get_sentiments("bing"), 3)
head(get_sentiments("nrc"), 3)
tidy_df[, season_episode := paste0('S', season_num,"XE", str_pad(episode_num,width = 2,pad = "0"))]
library(tidyr)
simpson_sentiment <- tidy_df %>%
inner_join(get_sentiments("bing")) %>%
count(season_episode, sentiment) %>%
spread(sentiment, n, fill = 0) %>%
mutate(sentiment = positive - negative)
Joining, by = "word"
head(simpson_sentiment,3)
simpson_sentiment <- as.data.table(simpson_sentiment)
simpson_sentiment[, season:= str_sub(season_episode,start = 1, end = 2)]
simpson_sentiment[, season:= str_replace(season, "S", "Season ")]
simpson_sentiment[, episode:= str_sub(season_episode,start = 4, end = 6)]
ggplot(simpson_sentiment, aes(episode, sentiment, fill = season)) +
geom_col(show.legend = FALSE) +
facet_wrap(~season, ncol = 2, scales = "free_x")
afinn <- tidy_df %>%
inner_join(get_sentiments("afinn")) %>%
group_by(season_episode) %>%
summarise(sentiment = sum(score)) %>%
mutate(method = "AFINN")
Joining, by = "word"
afinn <- as.data.table(afinn)
afinn[, season:= str_sub(season_episode,start = 1, end = 2)]
afinn[, season:= str_replace(season, "S", "Season ")]
afinn[, episode:= str_sub(season_episode,start = 4, end = 6)]
ggplot(afinn, aes(episode, sentiment, fill = season)) +
geom_col(show.legend = FALSE) +
facet_wrap(~season, ncol = 2, scales = "free_x")
resplandior <- tidy_df[season_num==6 & episode_num==6]
afinn_r <- resplandior %>%
inner_join(get_sentiments("afinn")) %>%
group_by(season_episode) %>%
summarise(sentiment = sum(score)) %>%
mutate(method = "AFINN") %>% data.table()
Joining, by = "word"
bing_and_nrc_r <- bind_rows(resplandior %>%
inner_join(get_sentiments("bing")) %>%
mutate(method = "Bing et al."),
resplandior %>%
inner_join(get_sentiments("nrc") %>%
filter(sentiment %in% c("positive",
"negative"))) %>%
mutate(method = "NRC")) %>%
count(method, sentiment) %>%
spread(sentiment, n, fill = 0) %>%
mutate(sentiment = positive - negative) %>% data.table()
Joining, by = "word"
Joining, by = "word"
comparativa <- rbind(afinn_r[, c("sentiment", "method"), with = F], bing_and_nrc_r[, c("sentiment", "method"), with = F])
ggplot(data=comparativa, aes(x=method, y=sentiment)) +
geom_bar(stat="identity",fill="steelblue")+
theme_minimal()
Si estás leyendo esto en diferido y tienes preguntas no dudes en localizarnos en Twitter